#!/usr/bin/perl -w
=head USAGE

  panda_enter_SMART_HMM_into_postgres.pl

=head PURPOSE

    This script takes
       multiple HMM files containing multiple HMMs
    and enters them into tables of a specified postgres database using
	source data from the SMART database as well

=head REMARKS

=cut
#die and warn check next

use strict;
use Getopt::Long;
use warnings;
use POSIX qw(:float_h); #for DBL_MAX
use DBI;
use DBD::Pg;
use String::CRC;

#88888888888888888888888888888888888888888888888888888888888888888888888888888888

#	Usage

#88888888888888888888888888888888888888888888888888888888888888888888888888888888

my $usage = <<'USAGE';

USAGE:

    panda_enter_SMART_HMM_into_postgres.pl
                            [--dbname        <panda>            ]
                            [--smart_dbname  <smart>            ]
                            [--user           <any_db_username>  ]
                            [--user_smart     <smart_db_username>]
                            [--password       <secret>           ]
                            [--password_smart <secret>           ]
					
                            [--help]
							<HMMFiles ...>

  				
  				
    This script takes multiple HMM files containing multiple HMMs
	together with source data from the SMART database
    and enters them into tables of a specified postgres database

	
USAGE









#88888888888888888888888888888888888888888888888888888888888888888888888888888888888888888

#	Get options

#88888888888888888888888888888888888888888888888888888888888888888888888888888888888888888

# options variables
my $help;
my $dbname='panda';
my $username='';
my $userpassword='';
my $dbname_smart='smart';
my $username_smart='postgres';
my $userpassword_smart='';

GetOptions (
			'help'				=> \$help,

			'dbname=s'			=> \$dbname,
			'user=s'			=> \$username,
			'password=s'		=> \$userpassword,

			'smart_dbname=s'	=> \$dbname_smart,
			'user_smart=s'		=> \$username_smart,
			'password_smart=s'	=> \$userpassword_smart,
			);



die $usage if ($help);
die "\nERROR:\n\tMissing HMM files:\n" .$usage
				unless (@ARGV);




				
				
#88888888888888888888888888888888888888888888888888888888888888888888888888888888888888888

#	Various functions

#88888888888888888888888888888888888888888888888888888888888888888888888888888888888888888
sub create_postgres_tables($);
sub parse_smart_domains_data($$$\%);
sub parse_and_save_HMM_file($$\%\%\@);
	sub lookup_domain_data_for_HMM(\%\%);	#?
	sub send_to_db($$\%);
		sub remove_matching_panda_domain_data($$);	#?
sub delete_obsolete_HMMs(\%$);
sub drop_indices($$);




#_________________________________________________________________________________________

#	drop_indices($$)

#		drops all indices for a given table and
#		returns the commands needed to recreate them

#_________________________________________________________________________________________
sub drop_indices($$)
{
	my ($dbh, $table_name) = @_;

	# get all index names and the commands to recreate them
	my $sth_get_indices	= $dbh->prepare("SELECT indexname, indexdef FROM pg_indexes "
							."WHERE tablename = ? ");
	$sth_get_indices->execute($table_name) or die "\nError:\n$DBI::errstr\n";
	my @recreate_commands;
	my @index_names;
	while (my @res = $sth_get_indices->fetchrow_array())
	{
		push(@recreate_commands, $res[1]);
		push(@index_names, $res[0]);
	}
	
	# return nothing if no indices on this table
	return () if (@index_names == 0);
	
	# drop all indices
	for (@index_names)
	{
		$dbh->do("DROP INDEX $_")
				  or die "\nError:\n$DBI::errstr\n";
	}
	
	return @recreate_commands;
}



#_________________________________________________________________________________________

#	create_postgres_tables


#_________________________________________________________________________________________

sub create_postgres_tables($)
{
	my ($dbh) = @_;	
	# this procedure tends to fail (if the tables already exist)
	# so no error messages but auto commit
	my @original_dbh_flags = @{$dbh}{'PrintError', 'AutoCommit', 'RaiseError'};
	@{$dbh}{'PrintError', 'AutoCommit', 'RaiseError'} = (0, 1, 0);
	if ($dbh->do( 'CREATE TABLE domains ('.
					'hmm_name          TEXT,'.				#	NAME
					'dom_code          INTEGER,'.			#	ACC
					'thres_true        DOUBLE PRECISION,'.	#	TC
					'thres_maybe       DOUBLE PRECISION,'.	#	NC
					'thres_repeat      DOUBLE PRECISION,'.	#	THRES_REPT
					'thres_subfamily   DOUBLE PRECISION,'.	#	THRES_FAM
					'definition        TEXT,'.				#	DEFN
					'description       TEXT,'.				#	DESC
					'binding_catalysis TEXT)'			)	#	BIND_CATA
		)
	{
		$dbh->do( 'CREATE INDEX i_domains__dom_code on domains(dom_code)');
	}

	$dbh->do( 'CREATE TABLE archived_domains ('.
					'hmm_name          TEXT,'.				#	NAME
					'dom_code          INTEGER,'.			#	ACC
					'thres_true        DOUBLE PRECISION,'.	#	TC
					'thres_maybe       DOUBLE PRECISION,'.	#	NC
					'thres_repeat      DOUBLE PRECISION,'.	#	THRES_REPT
					'thres_subfamily   DOUBLE PRECISION,'.	#	THRES_FAM
					'definition        TEXT,'.				#	DEFN
					'description       TEXT,'.				#	DESC
					'binding_catalysis TEXT,'.				#	BIND_CATA
					'dom_date_archived TIMESTAMP '.
							'DEFAULT CURRENT_TIMESTAMP)'	);

	if ($dbh->do('CREATE TABLE hmms ('.
					'hmm_name          TEXT,'.				#	NAME
					'hmm_acc           TEXT,'.				#	ACC
					'dom_code          INTEGER,'.			#	ACC
					'hmm_file          TEXT,'.				#	FILENAME
					'hmm_crc1          OID,'.				#	CRC1
					'hmm_crc2          OID,'.				#	CRC2
					'hmm_db_origin     TEXT,'.				#	'SMART'
					'aln_method        TEXT,'.				#	ALN_METHOD
					'db_state          TEXT,'.				#	DB_STATE
					'author            TEXT,'.				#	AUTH
					'hmm               TEXT,'.				#	HMM			
					'hmm_date_added    TIMESTAMP '.
							'DEFAULT CURRENT_TIMESTAMP)'	)
		)
	{
		$dbh->do( 'CREATE INDEX i_hmms__dom_code on hmms(dom_code)');
	}
	$dbh->do('CREATE TABLE new_hmms ('.
					'dom_code          INTEGER)'				);
	$dbh->do('CREATE TABLE archived_hmms ('.
					'hmm_name          TEXT,'.				#	NAME
					'hmm_acc           TEXT,'.				#	ACC
					'dom_code          INTEGER,'.			#	ACC
					'hmm_file          TEXT,'.				#	FILENAME
					'hmm_crc1          OID,'.				#	CRC1
					'hmm_crc2          OID,'.				#	CRC2
					'hmm_db_origin     TEXT,'.				#	'SMART'
					'aln_method        TEXT,'.				#	ALN_METHOD
					'db_state          TEXT,'.				#	DB_STATE
					'author            TEXT,'.				#	AUTH
					'hmm               TEXT,'.				#	HMM			
					'hmm_date_added    TIMESTAMP,'.
					'hmm_date_archived TIMESTAMP '.
							'DEFAULT CURRENT_TIMESTAMP)'	);
	if 	($dbh->do( 'CREATE TABLE domains_per_protein ('.
					'pi1               OID,'.
					'pi2               OID,'.
					'dom_code          INTEGER,'.
					'dom_name          TEXT,'.
					'start             INTEGER,'.
					'finish            INTEGER,'.
					'p_value           DOUBLE PRECISION,'.
					'confidence        INTEGER)'))
	{
		$dbh->do( 'CREATE INDEX i_domprot__pi on domains_per_protein(pi1,pi2)');
		$dbh->do( 'CREATE INDEX i_domprot__dom_code on domains_per_protein(dom_code)');
		$dbh->do( 'CREATE INDEX i_domprot__dom_name on domains_per_protein(dom_name)');
	}
	@{$dbh}{'PrintError', 'AutoCommit', 'RaiseError'} = @original_dbh_flags;
}	


#_________________________________________________________________________________________

#	parse_smart_domains_data

#				Obtain domain data from SMART


#_________________________________________________________________________________________
sub parse_smart_domains_data($$$\%)
{
	my ($dbname_smart, $username_smart, $userpassword_smart, $smart_domain_data) = @_;




	# connect to database
	my $dbh = DBI->connect( "dbi:Pg:dbname=$dbname_smart",
	                    $username_smart,
	                    $userpassword_smart,
						{
	                      RaiseError => 1,
	                      AutoCommit => 0
	                    }
	                  )
		or die "Error:\nSMART Database connection could not be made:\n$DBI::errstr\n";



	$dbh->do( 'CREATE TEMP TABLE temp_domain ('.
				'hmm_name          TEXT,'.				# NAME
				'dom_code          INTEGER,'.			# ACC
				'file_name         TEXT,'.				# FILENAME
				'dbsize            INTEGER,'.			# DBSIZE
				'thres_true        DOUBLE PRECISION,'.	# TC
				'thres_maybe       DOUBLE PRECISION,'.	# NC
				'thres_repeat      DOUBLE PRECISION,'.	# THRES_REPT
				'thres_subfamily   DOUBLE PRECISION,'.	# THRES_FAM
				'definition        TEXT,'.				# DEFN
				'description       TEXT,'.				# DESC
				'aln_method        TEXT,'.				# ALN_METHOD
				'db_state          TEXT,'.				# DB_STATE
				'author            TEXT,'.				# AUTH
				'binding_catalysis TEXT)');				# BIND_CATA

	$dbh->do( 'INSERT INTO temp_domain ('.
				'SELECT	name,'.
						'acc,'.
						'profile,'.
						'evd[1],'.
						'null,'.
						'null,'.
						'null,'.
						'null,'.
						'definition,'.
						'description,'.
						'aln_state,'.
						'db_state,'.
						'responsible,'.
						'binding_catalysis '.
				'FROM domain)');
	for (my $i = 0; $i < 5; ++$i)
	{
		my $panda_name = qw(thres_subfamily thres_maybe thres_true thres_repeat
							thres_true)[$i];
		my $smart_name = qw(cut_family cut_low cutoff repeat
							cut_off)[$i];
		$dbh->do( "UPDATE temp_domain SET $panda_name = thres_value ".
					'FROM threshold '.
					'WHERE '.
						'temp_domain.hmm_name = threshold.domain AND '.
						"thres_name = '$smart_name'");
	}

	# create statement handle for checking whether the entry already exists
	my $sth_get_all_domains = $dbh->prepare('SELECT * FROM temp_domain');

	my $rec_cnt;
	print STDERR '[';


	# get all domains
	$sth_get_all_domains->execute()
		or die "Error:\nFailed to obtain domains data from SMART$:\n$DBI::errstr\n";
	while (my (@data) = $sth_get_all_domains->fetchrow_array())
	{
		# hashed on filename only
		$data[2] =~ s/\.prf/.HMM/;
		my $file_name = $data[2];
		$smart_domain_data->{$file_name} = [@data];
		print STDERR "." if ($rec_cnt++ % 20 == 0);
	}
	

	print STDERR "]\n$rec_cnt\t SMART domain records parsed.\n";
	$dbh->disconnect();
}
#_________________________________________________________________________________________

#	parse_and_save_HMM_file

#				Parse HMM data

#_________________________________________________________________________________________
my $rec_cnt = 0;
sub parse_and_save_HMM_file($$\%\%\@)
{
	my ($hmm_file, $dbh, $HMMs, $smart_domain_data, $obsolete_hmms) = @_;


	open HMM_FILE, $hmm_file or die "Error:\nCould not open $hmm_file.\n$!\n";

	# create statement handle for checking whether the entry already exists
	my $sth_chk_exists	= $dbh->prepare(
									'SELECT hmm_name, hmm_acc, hmm_crc1, '.
									'hmm_crc2 '.
									'FROM hmms '.
									'WHERE dom_code = ?');

	# fields to be parsed from the HMM file
	my %HMM_FILE_FIELDS;
	@HMM_FILE_FIELDS{qw(NAME)} = ();

	# domain data parsed from the HMM
	my %HMM_fields;


	while (<HMM_FILE>)
	{
		# concatenate separate lines of HMM together
		$HMM_fields{'HMM'} .= $_;
		

		# end of record, process
		if (/^\/\//)
		{
			$HMM_fields{'FILENAME'}	= $hmm_file;
			# remove path
			$HMM_fields{'FILENAME'} =~ s[.*/][];

			my ($crc1, $crc2) = crc ($HMM_fields{'HMM'}, 64);
			$HMM_fields{'CRC1'}	= $crc1;
			$HMM_fields{'CRC2'}	= $crc2;

			# make sure all fields have been parsed
			foreach (keys %HMM_FILE_FIELDS)
			{
				die "Error:\nFailed to parse a field [$_] from the HMM file $hmm_file\n"
												unless defined ($HMM_fields{$_});
			}
				
			# only save if can find pfam data corresponding to the HMM
			if (lookup_domain_data_for_HMM(%HMM_fields, %$smart_domain_data))
			{
				$HMMs->{$HMM_fields{'DOM_CODE'}} = 0;
			

				# save hmm in list
				if (send_to_db($dbh, $sth_chk_exists, %HMM_fields))
				{
					print STDERR ":" if (++$rec_cnt % 20 == 0);
					$HMMs->{$HMM_fields{'DOM_CODE'}} = 1;
				}
			}
			else
			{
				push(@$obsolete_hmms, $HMM_fields{'FILENAME'}.' ['.$HMM_fields{'NAME'}.']');
				print STDERR "!" if (@$obsolete_hmms % 20 == 0);
			}
			
			# clear variables
			%HMM_fields = ();
			
		}
		# only save matching DATE, CKSUM, NAME, ACC, DESC, EVD
		next unless /^([A-Z]+) +(.*)\n/;
		next unless exists $HMM_FILE_FIELDS{$1};
		$HMM_fields{$1} = $2;

	}
	close HMM_FILE;
}	

#_________________________________________________________________________________________

#	lookup_domain_data_for_HMM

#				Takes data from an HMM record, prepares it for sending to the db

#		Parameters:



#_________________________________________________________________________________________
sub lookup_domain_data_for_HMM(\%\%)
{

	my ($HMM_fields, $smart_domain_data) = @_;

	my $hmm_filename = $HMM_fields->{'FILENAME'};

	return undef unless (exists $smart_domain_data->{$hmm_filename});

#	die "Error:\nData for the HMM file $filename_domain ".
#		"could not be found in the SMART database\n"
#		unless exists $smart_domain_data->{$hmm_filename};


	@{$HMM_fields}{	qw (NAME ACC FILENAME DBSIZE
						TC NC THRES_REPT THRES_FAM
						DEFN DESC ALN_METHOD DB_STATE
						AUTH BIND_CATA)} = @{$smart_domain_data->{$hmm_filename}};
	

	# convert e-value thresholds to p values
	foreach (qw(TC NC THRES_REPT THRES_FAM))
	{
		$HMM_fields->{$_} /= $HMM_fields->{'DBSIZE'} if defined $HMM_fields->{$_};
	}
	# db size no longer needed
	delete $HMM_fields->{'DBSIZE'};

	
	$HMM_fields->{'DB_ORIGIN'}= 'SMART';
	

	# set domain code
	# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	# smart accessions start at 0
	$HMM_fields->{'DOM_CODE'} = $HMM_fields->{'ACC'};
	$HMM_fields->{'ACC'}		= 'SM'.$HMM_fields->{'ACC'};
}






#_________________________________________________________________________________________

#	send_to_db

#				Enters domain data into the postgres table

#		Returns:
#				Whether anything was entered into panda
#		Parameters:

#				DBI database handle
#				DBI handle for SQL statement checking whether the entry already exists
#				List of data in a hash
#				List of data keys for the hash


#_________________________________________________________________________________________

sub send_to_db($$\%)
{
	# get parameters
	(my ($dbh, $sth, $HMM_fields)) = @_;
	
	

	# make sure all fields to be saved in the HMM file have been parsed
	my @hmms_table = qw (NAME ACC DOM_CODE FILENAME CRC1 CRC2
							DB_ORIGIN ALN_METHOD DB_STATE AUTH HMM);
	my @domains_table = qw (NAME DOM_CODE TC NC THRES_REPT
							THRES_FAM DEFN DESC BIND_CATA);



	# make sure all fields are parsed
	foreach (@domains_table, @hmms_table)
	{
		die "$!\n" unless exists $HMM_fields->{$_};
	}




	# return if the HMM is already up-to-date in the database
	$sth->execute($HMM_fields->{'DOM_CODE'}) or die "$!\n" ;
	if ($sth->rows == 1)
	{
		my ($name, $acc, $crc1, $crc2) = $sth->fetchrow_array();
		$sth->finish();
		if ($acc	eq $HMM_fields->{'ACC'}		&&
			$name	eq $HMM_fields->{'NAME'}	&&
			$crc1	eq $HMM_fields->{'CRC1'}	&&
			$crc2	eq $HMM_fields->{'CRC2'})
		{
			return undef;
		}
	}
	else
	{
		$sth->finish();
	}
	
	
	# remove all domain data for this code
	remove_matching_panda_domain_data($dbh, $HMM_fields->{'DOM_CODE'});


	
	# Enter in new HMM data
	$dbh->do( 	'INSERT INTO domains VALUES ('.
				join (	', ', ('?') x @domains_table) . ')',
				undef, @{$HMM_fields}{@domains_table});
	# add quotes for text
	for (qw (NAME ACC FILENAME DB_ORIGIN ALN_METHOD DB_STATE AUTH HMM))
	{
		# get rid of nulls
		$HMM_fields->{$_} |= '';
		$HMM_fields->{$_} = $dbh->quote($HMM_fields->{$_});
	}
	for (qw (CRC1 CRC2))
	{
		$HMM_fields->{$_} = "OID(".$HMM_fields->{$_}.")";
	}
	my $sql = 'INSERT INTO hmms VALUES ('.
				join (	', ', @{$HMM_fields}{@hmms_table}).
				')';
	$dbh->do($sql);


	# tag HMM as new entry
	$dbh->do( 	'INSERT into new_hmms VALUES (?)',
				undef, @$HMM_fields{'DOM_CODE'});

	return 1;
}				



#_________________________________________________________________________________________

#	remove_matching_panda_domain_data

#				Removes domain data in panda which matches a domain code

#		Parameters:

#				DBI database handle
#				domain_code


#_________________________________________________________________________________________
sub remove_matching_panda_domain_data($$)
{
	(my ($dbh, $dom_code)) = @_;

	# archive matching old HMMs
	$dbh->do(	'INSERT INTO archived_hmms ('.
				'SELECT * from hmms WHERE dom_code = ?)',
				undef, ($dom_code));
	$dbh->do(	'INSERT INTO archived_domains ('.
				'SELECT * from domains WHERE dom_code = ?)',
				undef, ($dom_code));

	# clear matching old HMMs
	$dbh->do( 	'DELETE FROM hmms WHERE dom_code = ?',
				undef, ($dom_code));
	$dbh->do( 	'DELETE FROM domains WHERE dom_code = ?',
				undef, ($dom_code));
	$dbh->do( 	'DELETE FROM new_hmms WHERE dom_code = ?',
				undef, ($dom_code));
			

	# clear matching HMM Seach results
	$dbh->do( 	'DELETE FROM domains_per_protein WHERE dom_code = ?',
				undef, ($dom_code));
}	
#_________________________________________________________________________________________


#	delete_obsolete_HMMs


# 		Delete obsolete HMMs
#		N.B. Calls bommit


#_________________________________________________________________________________________
sub delete_obsolete_HMMs(\%$)
{
	my ($HMMs, $dbh) = @_;
	my @curr_HMMs;

	# create statement handle for checking whether the entry already exists
	my $sth_get_all_domains = $dbh->prepare('SELECT dom_code FROM hmms WHERE '.
											"hmm_db_origin = 'SMART'");
	$sth_get_all_domains->execute() or die "$!\n" ;
	while (my ($dom_code) = $sth_get_all_domains->fetchrow_array())
	{
		push (@curr_HMMs, $dom_code);
	}
	$sth_get_all_domains->finish();

	my @obsolete_HMMs;
	foreach(@curr_HMMs)
	{
		push(@obsolete_HMMs, $_) unless exists ($HMMs->{$_});
	}

	foreach my $dom_code(@obsolete_HMMs)
	{
		remove_matching_panda_domain_data($dbh, $dom_code);
	}

	
}	







#88888888888888888888888888888888888888888888888888888888888888888888888888888888888888888

#	Core logic!!

#88888888888888888888888888888888888888888888888888888888888888888888888888888888888888888
# connect to database
my $dbh = DBI->connect( "dbi:Pg:dbname=$dbname",
                        $username,
                        $userpassword,
						{
                          RaiseError => 1,
                          AutoCommit => 0,
						  PrintError => 1
                        }
                      )
		or die "Database connection not made: $DBI::errstr";

# make sure HMM / domain tables are present in the database
create_postgres_tables($dbh);


#drop all indices on the tables
my @sql_recreate_indices_new_hmms	= drop_indices($dbh, 'new_hmms');
my @sql_recreate_indices_domains	= drop_indices($dbh, 'domains');
my @sql_recreate_indices_hmms		= drop_indices($dbh, 'hmms');



# read in smart data
my %smart_domain_data;
parse_smart_domains_data($dbname_smart, $username_smart, $userpassword_smart, %smart_domain_data);


		
# save list of SMART HMMs
my %HMMs;

# for each HMM, put SMART data into the Panda database
my @obsolete_hmms;

print STDERR '[';
foreach my $hmm_file(@ARGV)
{
	parse_and_save_HMM_file($hmm_file, $dbh, %HMMs, %smart_domain_data, @obsolete_hmms);
}
print STDERR "]\n";

# remove data for obsolete domains
delete_obsolete_HMMs(%HMMs, $dbh);
$dbh->commit();


# make sure new_hmm tables does not contain duplicates
$dbh->do("CREATE TABLE temp_new_hmms as SELECT DISTINCT on (dom_code) * from new_hmms");
$dbh->do("DROP TABLE new_hmms");
$dbh->do("ALTER TABLE temp_new_hmms rename to new_hmms");


#recreate indices
$dbh->do($_) or die "\nError:\n$DBI::errstr\n" for (@sql_recreate_indices_new_hmms);
$dbh->do($_) or die "\nError:\n$DBI::errstr\n" for (@sql_recreate_indices_domains);
$dbh->do($_) or die "\nError:\n$DBI::errstr\n" for (@sql_recreate_indices_hmms);


# commit changes and disconnect
$dbh->commit();
$dbh->disconnect();

# report results
my $cnt_HMMs;
$cnt_HMMs += $HMMs{$_} for(keys %HMMs);
print STDERR "\nSuccess!!!\n$cnt_HMMs SMART HMMs and their data entered into panda.\n";

# list of hmms which are obsolete
if (@obsolete_hmms)
{
	print STDERR scalar @obsolete_hmms, " HMM records do not have ".
			"corresponding data in the SMART database.\n\n";
	print "These SMART domains are most probably obsolete and will not be entered into panda:\n";
	print join "\n", @obsolete_hmms, "";
}

				
		
